The Games Machine 2 (DVD)/XENIADVD2.iso/Patch/Project Nomads/pnomads_patch2_eng.exe/MAINDIR/Run/scripts/scriptlib.tcl

Text File | 2002-09-11 | 46.9 KB | 1,435 lines

#-------------------------------------------------------------------------------
#   scriptlib.tcl
#   =============
#   Implement the command set for the story scripting.
#
#   (C) 2001,2002 RadonLabs GmbH
#-------------------------------------------------------------------------------

#-------------------------------------------------------------------------------
#   Global variables
#-------------------------------------------------------------------------------
set curBook ""
set curBookDir ""

set curChapter ""
set curChapterDir ""

set curPart ""
set curPartDir ""

#-------------------------------------------------------------------------------
#   on_bookfinished
#
#   This procedure is called by the book handler when the last part
#   has been finished.
#
#   This procedure call the nm_reallykillgame procedure defined in
#   newmenu.tcl.
#-------------------------------------------------------------------------------
proc on_bookfinished {} {
    nm_thanxforplaying
}

#-------------------------------------------------------------------------------
#   book [body]
#
#   Define a book. Inside the book only 'loadchapter' statements should
#   appear.
#-------------------------------------------------------------------------------
proc book {body} {
global curBook
global curBookDir
    set curBookDir [/sys/servers/file.manglepath "book:"]
    eval $body
}

#-------------------------------------------------------------------------------
#   loadchapter [dirname]
#
#   This takes the name of a subdirectory and simply sources
#   the story.tcl file in this directory. This story.tcl file should
#   contain a single 'chapter' statement.
#-------------------------------------------------------------------------------
proc loadchapter {dirname} {
global curBookDir
global curChapterDir

#    puts "-> loadchapter $dirname"

    set curChapterDir ""
    append curChapterDir "$curBookDir" "$dirname"

    set cwd [pwd]
    set dir [/sys/servers/file.manglepath $curChapterDir]
    cd $dir
    source story.tcl
    cd $cwd

#    puts "<- loadchapter"
}

#-------------------------------------------------------------------------------
#   loadpart [dirname]
#
#   This takes the name of a subdirectory and simply source the
#   story.tcl file in this directory. This story.tcl file should
#   contain a single 'part' statement.
#-------------------------------------------------------------------------------
proc loadpart {dirname} {
global curChapterDir
global curPartDir

#    puts "-> loadpart $dirname"

    set curPartDir ""
    append curPartDir "$curChapterDir" "/" "$dirname"

    set cwd [pwd]
    set dir [/sys/servers/file.manglepath $curPartDir]
    cd $dir
    source story.tcl
    cd $cwd

#    puts "<- loadpart"
}

#-------------------------------------------------------------------------------
#   chapter [name] [body]
#
#   Define a chapter. A chapter should consist of only 'loadpart' statements.
#-------------------------------------------------------------------------------
proc chapter {name body} {
global curChapter

#    puts "-> chapter $name"

    # set global chapter variable and just execute the body
    # which will actually call several 'loadpart' statements
    set curChapter $name
    eval $body

#    puts "<- chapter"
}

#-------------------------------------------------------------------------------
#   part [name] [body]
#
#   Define a part with its activation Tcl code. The body should only
#   contain event handlers ('on' statements).
#-------------------------------------------------------------------------------
proc part {name body} {
global curChapter
global curPart
global curPartDir

#    puts "-> part $name"

    set curPart $name

    # build a unique part name from the chapter name and the part
    # name and register the part handler code with the book handler
    set partName ""
    append partName "$curChapter" "_" "$curPart"
    /game/handler/book.registerpart $partName $curPartDir $body

#    puts "<- part"
}

#-------------------------------------------------------------------------------
#   on [event0] [and|or] [event1] [body]
#
#   Define an event handler for one or two events. The body is executed
#   when the one or two events are triggered (in the case of two events,
#   they can be "and" or "or" connected).
#
#   Implementation details:
#   The procedure will create a Tcl procedure called "event_handler_$uniqueId"
#   which is registered with the global nEventHandler object. The event handler
#   will be called when the events are triggered by the event handler.
#
#-------------------------------------------------------------------------------
proc on {args} {

#    puts "-> on $args"

    # num args can either be 3 or 6 (depends whether one or 2 events are given)
    if {[llength $args] == 2} {

        set event0 [lindex $args 0]
        set body [lindex $args 1]

        # add the event handler
        /game/handler/event.addhandler $body $event0

    } elseif {[llength $args] == 4} {

        set event0 [lindex $args 0]
        set opcode [lindex $args 1]
        set event1 [lindex $args 2]
        set body   [lindex $args 3]

        # add the event handler
        /game/handler/event.addhandler2 $body $event0 $opcode $event1

    } else {
        # syntax error
        puts "WRONG NUMBER OF ARGS IN PROC 'on $args'"
        exit
    }

#    puts "<- args"
}

#-------------------------------------------------------------------------------
#   loadencounter [filename] [as symbolicName] [pos x y z]
#
#   Loads an encounter inside a part, optionally gives it a symbolic name
#   for later reference and places it at a position. The actual filename of the
#   encounter is generated as follos:
#
#   $currentPartDir/encounters/$filename
#
#   The current part dir is requested from the book hander
#-------------------------------------------------------------------------------
proc loadencounter {filename args} {

#    puts "-> loadencounter $filename $args"

    # extract optional data
    set numArgs [llength $args]
    set symbolicName ""
    set hasPos 0
    set xPos 0
    set yPos 0
    set zPos 0
    if {$numArgs > 0} {

        for {set curArg 0} {$curArg < $numArgs} {incr curArg} {
            if {[lindex $curArg] == "as"} {
                incr curArg
                set symbolicName [lindex $args $curArg]
            } elseif {[lindex $curArg] == "pos"} {
                set hasPos 1
                incr curArg
                set xPos [lindex $args $curArg]
                incr curArg
                set yPos [lindex $args $curArg]
                incr curArg
                set zPos [lindex $args $curArg]
            }
        }
    }

    # get the full filename for the encounter file
    set partDir [/game/handler/book.getcurrentpartdir]

    # All cinematic are placed here
    if {[exists /game/cinematics] == 0} {
    new nroot /game/cinematics
    }

    # Load cinematic sequences for encounter if any exist
    set cinematicFile ""
    append cinematicFile "$partDir" "/cinematics/" "$filename"
    if {[file exists $cinematicFile] == 1} {
        source $cinematicFile
    }

    # load the encounter
    set encounterFile ""
    append encounterFile "$partDir" "/encounters/" "$filename"
    set clan [/world.loadencounter $encounterFile]

    # optionally position it
    if {$hasPos} {
        $clan.setposition $xPos $yPos $zPos
    }

    # optionally set symbolic name
    if {$symbolicName != ""} {
        $clan.setrealname $symbolicName
    }

#    puts "<- loadencounter"
}

#-------------------------------------------------------------------------------
#   finishpart
#
#   Finish the current part and activate the next part. Slowly fade out audio
#-------------------------------------------------------------------------------
proc finishpart {} {
    oneshottimer 3 _partfinished
    /sys/servers/audio.flushaudio 3 3
    newv chptr_fadeout
}

#-------------------------------------------------------------------------------
#   startpart
#
#   Start with fadein.
#-------------------------------------------------------------------------------

proc startpart {} {
    newv chptr_fadein
}

#-------------------------------------------------------------------------------
#   timer seconds event [as symbolicName]
#
#   Creates an infinite timer which throws an event every number
#   of seconds.
#   Please make sure the the environment setting is already loaded
#   before creating any timers because all timer objects are created
#   in the environment clan!!!
#-------------------------------------------------------------------------------
proc timer {seconds event args} {

    # get the environemt clan
    set clan [/world.getenvironmentclan]
    if {"null" == $clan} {
        # makes no sense without env clan
        return
    }

    # parse optional args
    set numArgs [llength $args]
    set symbolicName ""
    if {$numArgs > 0} {
        for {set curArg 0} {$curArg < $numArgs} {incr curArg} {
            if {[lindex $args $curArg] == "as"} {
                incr curArg
                set symbolicName [lindex $args $curArg]
            }
        }
    }

    # create a t_timer object
    set t [$clan.createvehicle t_timer]
    $t.setthrowevents true
    $t.seteventslot timer "$event"
    $t.setnumcycles 0
    $t.setcycletime $seconds
    if {$symbolicName != ""} {
        $t.setsymbolicname $symbolicName
    }
}

#-------------------------------------------------------------------------------
#   oneshottimer seconds event [as symbolicName]
#
#   Creates an oneshot timer which throws exactly one event and
#   then self-destructs.
#   Please make sure the the environment setting is already loaded
#   before creating any timers because all timer objects are created
#   in the environment clan!!!
#-------------------------------------------------------------------------------
proc oneshottimer {seconds event args} {

    # get the environemt clan
    set clan [/world.getenvironmentclan]
    if {"null" == $clan} {
        # makes no sense without env clan
        return
    }

    # parse optional args
    set numArgs [llength $args]
    set symbolicName ""
    if {$numArgs > 0} {
        for {set curArg 0} {$curArg < $numArgs} {incr curArg} {
            if {[lindex $args $curArg] == "as"} {
                incr curArg
                set symbolicName [lindex $args $curArg]
            }
        }
    }

    # create a t_timer object
    set t [$clan.createvehicle t_timer]
    $t.setthrowevents true
    $t.seteventslot timer "$event"
    $t.setnumcycles 1
    $t.setcycletime $seconds
    if {$symbolicName != ""} {
        $t.setsymbolicname $symbolicName
    }
}

#-------------------------------------------------------------------------------
#   oneshotaction seconds action
#
#   analog onmeshot-timer, aber mit aktion (script)
#-------------------------------------------------------------------------------
proc oneshotaction {seconds action} {

    # get the environemt clan
    set clan [/world.getenvironmentclan]

    if {$clan != "null"} {
        # create a t_timer object
        set t [$clan.createvehicle t_timer]
        $t.setthrowevents true
        $t.setaction "$action"
        $t.setnumcycles 1
        $t.setcycletime $seconds
    }
}

#-------------------------------------------------------------------------------
#   looptimer numloops seconds event [as symbolicName]
#
#   Creates an loop timer which throws exactly $numloop events and
#   then self-destructs.
#   Please make sure the the environment setting is already loaded
#   before creating any timers because all timer objects are created
#   in the environment clan!!!
#-------------------------------------------------------------------------------
proc looptimer {numloops seconds event args} {

    # get the environemt clan
    set clan [/world.getenvironmentclan]
    if {"null" == $clan} {
        # makes no sense without env clan
        return
    }

    # parse optional args
    set numArgs [llength $args]
    set symbolicName ""
    if {$numArgs > 0} {
        for {set curArg 0} {$curArg < $numArgs} {incr curArg} {
            if {[lindex $args $curArg] == "as"} {
                incr curArg
                set symbolicName [lindex $args $curArg]
            }
        }
    }

    # create a t_timer object
    set t [$clan.createvehicle t_timer]
    $t.setthrowevents true
    $t.seteventslot timer "$event"
    $t.setnumcycles $numloops
    $t.setcycletime $seconds
    if {$symbolicName != ""} {
        $t.setsymbolicname $symbolicName
    }
}

#-------------------------------------------------------------------------------
#   activate symbolicName
#
#   Invoke ".setthrowevents true" on all objects with a matching symbolic
#   name.
#-------------------------------------------------------------------------------
proc activate {symbolicName} {

    puts "-> activate $symbolicName"

    set curObj ""
    for {set curObj [/world.findobjectbysymbolicname $symbolicName]}\
        {$curObj != "null"}\
        {set curObj [/world.findnextobjectbysymbolicname $curObj $symbolicName]}\
    {
        $curObj.setthrowevents true
    }

    puts "-> activate $symbolicName"
}

#-------------------------------------------------------------------------------
#   deactivate symbolicName
#
#   Invoke ".setthrowevents false" on all objects with a matching symbolic
#   name.
#-------------------------------------------------------------------------------
proc deactivate {symbolicName} {

    puts "-> deactivate $symbolicName"

    set curObj ""
    for {set curObj [/world.findobjectbysymbolicname $symbolicName]}\
        {$curObj != "null"}\
        {set curObj [/world.findnextobjectbysymbolicname $curObj $symbolicName]}\
    {
        $curObj.setthrowevents false
    }

    puts "-> deactivate $symbolicName"
}

#-------------------------------------------------------------------------------
#   setfaction symbolicName [player | enemy1 | enemy2 | enemy3 | enemy4]
#
#   Set faction of all clans which match the symbolicName
#-------------------------------------------------------------------------------
proc setfaction {symbolicName faction} {

    # convert faction string into number
    set factionId 0
    if {$faction == "player"} {
        set factionId 0
    } elseif {$faction == "enemy1"} {
        set factionId 1
    } elseif {$faction == "enemy2"} {
        set factionId 2
    } elseif {$faction == "enemy3"} {
        set factionId 3
    } elseif {$faction == "enemy4"} {
        set factionId 4
    } else {
        # undefined factionId, set to 128 for now
        set factionId 128
    }

    set curClan ""
    for {set curClan [/world.findclanbysymbolicname $symbolicName]}\
        {$curClan != "null"}\
        {set curClan [/world.findnextclanbysymbolicname $curClan $symbolicName]}\
    {
        puts "$curClan.setfaction $factionId"
        $curClan.setfaction $factionId
    }
}

#-------------------------------------------------------------------------------
#   putevent event
#
#   Manually throw an event.
#-------------------------------------------------------------------------------
proc putevent {event} {
    /game/handler/event.putevent $event
}

#-------------------------------------------------------------------------------
#   daytime hours minutes
#
#   Set the game's time of day.
#-------------------------------------------------------------------------------
proc daytime {hours mins} {

    set seconds [expr ($hours * 3600) + ($mins * 60)]
    /world.settimeofday $seconds
}

#-------------------------------------------------------------------------------
#   resetplayerat
#
#   Reset the player's island to position x y z and the players character
#   to some predefined respawn point on the island. Used to position
#   the island at the beginning of a part.
#-------------------------------------------------------------------------------
proc resetplayerat { x y z } {

    # find the player's towncenter
    set userClan [/world.getuserclan]
    if {$userClan != "null"} {

        # set player island to x,y,z
        set playerIsland [$userClan.getplayerisland]
        $playerIsland.setposition  $x $y $z
        $playerIsland.setdirection 0 0 0

        # position maennel at towncenter
        set player [$userClan.getmaennel]

        # reset handelt by world
        /world.resetuserclan

        # some things must be done separatly
        # war mal swim - bug beim drehen der playerisland
        $player.setstate stand
        #input_stand

        # update the save point
        savepoint
    }
}


proc resetplayer {} {
    resetplayerat 0 0 0
}

#-------------------------------------------------------------------------------
#   simpleresetat
#
#   Resets only most important things, world and Island.
#   To use in levels with introcinematic, that place and animate
#   the playercharacter via cinedummy so that the procedure doesn't affect
#   players position.
#-------------------------------------------------------------------------------
proc simpleresetat {x y z} {

    # find the player's towncenter
    set userClan [/world.getuserclan]
    if {$userClan != "null"} {

        # set player island to x,y,z
        set playerIsland [$userClan.getplayerisland]
        $playerIsland.setposition  $x $y $z
        $playerIsland.setdirection 0 0 0

        # position maennel at towncenter
        # set player [$userClan.getmaennel]

        # reset handelt by world
        /world.resetuserclan

        # some things must be done separatly
        #$player.setstate swimming
        #input_swimming

        # update the save point
        savepoint
    }
}

#-------------------------------------------------------------------------------
#   destroy symbolicName
#
#   Invoke ".reduceenergy 10000000" on all objects with a matching symbolic
#   name.
#-------------------------------------------------------------------------------
proc killsymbol {symbolicName} {

    puts "-> destroy $symbolicName"

    set curObj ""
    for {set curObj [/world.findobjectbysymbolicname $symbolicName]}\
        {$curObj != "null"}\
        {set curObj [/world.findnextobjectbysymbolicname $curObj $symbolicName]}\
    {
        #puts "destroy: $curObj"
        $curObj.reduceenergy 10000000
    }

    puts "<- destroy $symbolicName"
}

#-------------------------------------------------------------------------------
#   support method. searches for navpoint with specified symbolic name
#-------------------------------------------------------------------------------
proc getnavpoint {symbolicName} {

    set navPoint [/world.findobjectbysymbolicname $symbolicName]
    if {$navPoint == "null"} {
        return "null"
    } else {
        if {"false" == [$navPoint.isvehicleclass "abstract.navpoint"]} {
            return "null"
        } else {
            return $navPoint
        }
    }
}

#-------------------------------------------------------------------------------
#   enableNavPoint symbolicName
#
#   tries to find Navpoint with symbolic name and enables it. Stops if navpoint
#   does not exist or "symbolicName" is no navpoint. Allows multiple enable calls
#
#   04-Apr-02   floh    notify feedback handler
#-------------------------------------------------------------------------------
proc enablenavpoint {symbolicName} {
    set navPoint [getnavpoint $symbolicName]

    if {$navPoint != "null"} {
        $navPoint.enable
        /game/handler/feedback.registernavpointenabled
    } else {
        puts "***** NAVPOINT $symbolicName EXISTIERT NICHT ********"
    }
}

proc enablenavpoint_mute {symbolicName} {
    set navPoint [getnavpoint $symbolicName]

    if {$navPoint != "null"} {
        $navPoint.enable
    } else {
        puts "***** NAVPOINT $symbolicName EXISTIERT NICHT ********"
    }
}

proc enablenavpointafter {time symbolicName} {
    set action "enablenavpoint $symbolicName"
    oneshotaction $time  $action
}

proc enablenavpointafter_mute {time symbolicName} {
    set action "enablenavpoint_mute $symbolicName"
    oneshotaction $time  $action
}

#-------------------------------------------------------------------------------
#   disableNavPoint symbolicName
#
#   tries to find Navpoint with symbolic name and disables it. Stops if navpoint
#   does not exist or "symbolicName" is no navpoint. Allows multiple enable calls
#-------------------------------------------------------------------------------
proc disablenavpoint {symbolicName} {

    set navPoint [getnavpoint $symbolicName]
    set station [[/world.getuserclan].getplayerisland]
    set targetNavPoint [$station.getislandtarget]
    if {$navPoint != "null"} {
        if {$navPoint == $targetNavPoint} {
            $station.setislandtarget "null"
        }
        $navPoint.disable
    } else {
        puts "***** NAVPOINT $symbolicName EXISTIERT NICHT ********"
    }
}

#-------------------------------------------------------------------------------
#   playerhasitem symbolicName
#
#   Seeks the whole inventory to find symbolicName
#-------------------------------------------------------------------------------
proc playerhasitem {symbolicName} {

    puts "-> playerhasitem $symbolicName"

    set clan     [/world.getuserclan]
    set maennel  [$clan.getmaennel]
    set itemlist [$maennel.artefactlist]
    set result   "false"

    foreach curItem $itemlist {
        set curItemsymbolicName [$curItem.getsymbolicname]

        if { [string match $symbolicName $curItemsymbolicName] } {
            set result "true"
            break
        }
    }

    puts "<- playerhasitem $symbolicName $result"
    return $result
}

#-------------------------------------------------------------------------------
#   removeplayeritem symbolicName
#
#   Seeks the whole inventory to find symbolicName and remove it
#-------------------------------------------------------------------------------
proc removeplayeritem {symbolicName} {

    puts "-> removeplayeritem $symbolicName"

    set clan     [/world.getuserclan]
    set maennel  [$clan.getmaennel]
    set itemlist [$maennel.artefactlist]
    set result   "false"

    foreach curItem $itemlist {
        set curItemsymbolicName [$curItem.getsymbolicname]

        if { [string match $symbolicName $curItemsymbolicName] } {
            $clan.releasevehicle $curItem
            set result "true"
            break
        }
    }

    puts "<- playerhasitem $symbolicName $result"
    return $result
}

#-------------------------------------------------------------------------------
#   removeplayeritemandslot symbolicName
#
#   Remove an artefact from the belt, release it (via removeplayeritem),
#   and if the operation was successful, reduce number of belt slots by one.
#-------------------------------------------------------------------------------
proc removeplayeritemandslot {symbolicName} {

    puts "-> removeplayeritemandslot $symbolicName"

    set result [removeplayeritem $symbolicName]
    if {$result == "true"} {
        set maennel [[/world.getuserclan].getmaennel]
        set curMaxArtefacts [$maennel.getmaxartefacts]
        if {$curMaxArtefacts > 1} {
            incr curMaxArtefacts -1
            $maennel.setmaxartefacts $curMaxArtefacts
        }
    }
}

#-------------------------------------------------------------------------------
#   countbysymbolicname symbolicName
#
#   Counts Objects with Symbolic Name
#-------------------------------------------------------------------------------
proc countbysymbolicname {symbolicName} {

    puts "-> countbysymbolicname $symbolicName"

    set clan     [/world.getuserclan]
    set maennel  [$clan.getmaennel]
    set result   "0"

    set curObj ""
    for {set curObj [/world.findobjectbysymbolicname $symbolicName]}\
        {$curObj != "null"}\
        {set curObj [/world.findnextobjectbysymbolicname $curObj $symbolicName]}\
    {
        incr result 1
    }

    puts "<- countbysymbolicname $symbolicName $result"

    return $result
}

#-------------------------------------------------------------------------------
#   setclanenergyzero symbolicName
#
#   Set Clan with symbolicName Energy to Zero
#-------------------------------------------------------------------------------
proc setclanenergyzero {symbolicName} {

    puts "-> setclanenergyzero $symbolicName"

    for {set curObj [/world.findclanbysymbolicname  $symbolicName]}\
        {$curObj != "null"}\
        {set curObj [/world.findnextclanbysymbolicname $curObj $symbolicName]}\
    {
         $curObj.setcurrentenergy 0
    }

    puts "<- setclanenergyzero $symbolicName"
}

#-------------------------------------------------------------------------------
#   maennelcanfly [true|false]
#
#   Turn flying ability of maennel on/off.
#-------------------------------------------------------------------------------
proc maennelcanfly {flag} {

    puts "-> maennelcanfly $flag"

    # get the user maennel
    set userClan [/world.getuserclan]
    set maennel [$userClan.getmaennel]
    $maennel.setcanfly $flag

    if {"true" == $flag} {
        # report to feedback handler
        # wird vom boosterartefakt selbst gefeuert
        # /game/handler/feedback.registermaennelcanfly
    }
}

#-------------------------------------------------------------------------------
#   givetask symbolicName task parameter
#
#   universelles settask fuer ein Objekt
#   symbolicName            wer soll das machen (z.B. "mueller")
#   task                    was soll er machen (z.B. "attack")
#   parameter               was soll er bearbeiten (z.B. "meier")
#
#   27-Feb-02   floh    + all objects which match the symbolic name get the task
#                       + no longer causes game to quit when no matching object
#                         exists
#-------------------------------------------------------------------------------
proc givetask {symbolicName task parameter} {

puts "*** givetask $symbolicName $task $parameter"
    set curObj ""
    for {set curObj [/world.findobjectbysymbolicname $symbolicName]}\
        {$curObj != "null"}\
        {set curObj [/world.findnextobjectbysymbolicname $curObj $symbolicName]}\
    {
        if {[$curObj.isvehicleclass "concret.technical.static.building.flakbuilding"] == "true"} {
            set curObjproduct [$curObj.getproduct 0]
            if {$curObjproduct != "null"} {
                $curObjproduct.settask $task $parameter
                puts "ist eine flak $task $parameter und gibt befehl an turret $curObjproduct"
            }
        } elseif {[$curObj.isvehicleclass "concret.technical.static.building.garage"] == "true"} {
            set curObjproduct [$curObj.getproduct 0]
            if {$curObjproduct != "null"} {
                $curObjproduct.settask $task $parameter
                puts "ist eine garage mit $task $parameter und gibt befehl an flieger $curObjproduct"
            }
        }
        $curObj.settask $task $parameter
        puts "--- task $task given to object $curObj"
    }
}

#-------------------------------------------------------------------------------
#   killafter time symbolicname
#
#   Fa▀t den hΣufig gebrauchten Zusammenhang, da▀ etwas nach einer bestimmten
#   Zeit gekillt werden soll zusammen
#   (eventname ist nur aus Kompatibilaetsgruenden noch da)
#-------------------------------------------------------------------------------
proc killafter {time symbolicname {eventname "meier"}} {

    set action "killsymbol $symbolicname"
    oneshotaction $time  $action
}

#-------------------------------------------------------------------------------
#   loadafter time encountername
#
#   Fa▀t den hΣufig gebrauchten Zusammenhang, da▀ etwas nach einer bestimmten
#   Zeit geladen werden soll zusammen (encounter)
#-------------------------------------------------------------------------------
proc loadafter {time encountername {eventname "mueller"}} {

    set action "loadencounter $encountername"
    oneshotaction $time  $action
}

#-------------------------------------------------------------------------------
#   islandmoveto navpointname
#
#   02-Apr-02   floh    Bugfix: hat nicht den Fall abgehandelt, dass es
#                       den Navpoint ueberhaupt nicht gibt!
#   29-Jul-02   floh    hat auch funktioniert, wenn ueberhaupt kein Navtower
#                       aufgebaut war
#-------------------------------------------------------------------------------

proc islandmoveto {navpointname} {

    set target [/world.findobjectbysymbolicname $navpointname]
    set userClan [/world.getuserclan]
    if {($target != "null") && ($userClan != "null")} {
        set station [$userClan.getplayerisland]
        if {$station != "null"} {
            enablenavpoint_mute $navpointname
            $station.setislandtarget $target

            # check if there is any navtower in house state in the user clan
            set hasValidNavTower 0
            for {set curObj [$userClan.gethead]} {$curObj != "null"} {set curObj [$curObj.getsucc]} {
                if {[$curObj.isvehicleclass "concret.technical.static.building.islanddrive"]} {
                    if {[$curObj.getstate] == "house"} {
                        set hasValidNavTower 1
                    }
                }
            }
        }

        if {$hasValidNavTower} {
            $station.setislanddriveworking true
        }

    } else {
        puts "*** NAVPOINT $navpointname EXISTIERT NICHT IN ROUTINE islandmoveto!!!"
    }
}

#-------------------------------------------------------------------------------
#   setvar name value
#
#   Setzt eine Cookie-Variable auf einen Wert. Cookies bleiben waehrend des
#   gesamten Spiels erhalten (auf ueber Part- und Chapter-Grenzen hinweg)
#   und werden bei Savegames mit abgespeichert und geladen.
#-------------------------------------------------------------------------------
proc setvar {name value} {
    /game/handler/cookie.setcookie $name $value
}

#-------------------------------------------------------------------------------
#   getvar name value
#
#   Fragt den Wert einer Cookie-Variablen ab. Falls die Cookie Variable nicht
#   existiert wird ein ":null:" String zurueckgegeben.
#-------------------------------------------------------------------------------
proc getvar {name} {
    return [/game/handler/cookie.getcookie $name]
}

#-------------------------------------------------------------------------------
#   clearvar name
#
#   Markiert eine Variable als temporaer, so dass sie am Ende eines Parts
#   automatisch geloescht wird
#-------------------------------------------------------------------------------
proc clearvar {name} {
    /game/handler/cookie.marktemporary $name
}

#-------------------------------------------------------------------------------
#   existsvar name
#
#   Gibt "true" zurueck falls die Cookie-Variable existiert, andernfalls
#   "false".
#-------------------------------------------------------------------------------
proc existsvar {name} {
    return [/game/handler/cookie.cookieexists $name]
}

#-------------------------------------------------------------------------------
#   wind stΣrke
#
#    Stellt die WindstΣrke ein...
#-------------------------------------------------------------------------------
proc wind {strength} {
    /sys/servers/channel.setchannel1f windstrength $strength
    return
}

#-------------------------------------------------------------------------------
#   savepoint
#   Speichert Spiel in speziellen savepoint.n Save-Slot ab.
#-------------------------------------------------------------------------------
proc savepoint {} {
    /world.announcesavepoint "home:save/savepoint"
}

#-------------------------------------------------------------------------------
#   loadsavepoint
#   Lade den aktuellen Save-Point.
#-------------------------------------------------------------------------------
proc loadsavepoint {} {
    /world.announceloadsavepoint "home:save/savepoint.n"
}

#-------------------------------------------------------------------------------
#   restartlevel
#   Startet den aktuellen Part neu
#-------------------------------------------------------------------------------
proc restartlevel {} {
    puts "*** RESTART LEVEL"

    set path [/sys/servers/file.manglepath "home:save"]
    if {[file exists $path/restartpoint.n]} {
        /world.loadgame $path/restartpoint.n
    }
}

#-------------------------------------------------------------------------------
#   playanimation symbolicName
#
#  symbolicname der jeweiligen cinematic oder des CINdummy
#
#-------------------------------------------------------------------------------
proc playanimation {symbolicName} {
    puts "-> animate CINEMATICDUMMY: $symbolicName"

    # find cinedummy object
    set cineDummy [/world.findobjectbysymbolicname $symbolicName]
    if {$cineDummy != "null"} {

        puts "-> cinematic TARGET OBJECT: [$cineDummy.gettargetsymbolicname]"

        # find target object
        set cineTargetSymbolic [$cineDummy.gettargetsymbolicname]
        set cineSequence [$cineDummy.getcinematicsequencename]
        set cineTarget [/world.findobjectbysymbolicname $cineTargetSymbolic]
        if {$cineTarget != "null"} {

            set cineTargetState [$cineTarget.getstate]
            set action ""

            if {$cineTargetState == "explode"} {

                # target is exploding: ignore
                return

            } else {
                # normal case:
                set action "$cineTarget.setcinematicsequence $cineSequence; $cineTarget.setstate cinematic"
            }
            oneshotaction 0.01 $action
        }
    } else {
        puts " ! WARNUNG ! - cinematicDUMMY nicht gefunden (symbolicName = $symbolicName)!!!"
    }
}

#-------------------------------------------------------------------------------
#   playanimationafter time symbolicName
#-------------------------------------------------------------------------------
proc playanimationafter {time symbolicName} {
    set action "playanimation $symbolicName"
    oneshotaction $time $action
}

#-------------------------------------------------------------------------------
#   stopanimation symbolicName
#
#  symbolicname - der jeweiligen cinematic oder des cinematicdummys
#  ( der ja targetsymbolicname hat)
#-------------------------------------------------------------------------------
proc stopanimation {symbolicName} {
    puts "-> STOP animattion CINEMATICDUMMY: $symbolicName"
    set pos [/world.findobjectbysymbolicname $symbolicName]
    if {$pos != "null"} {
        puts "-> cinematic OBJECT: [$pos.gettargetsymbolicname] : STOP"
        $pos.announcestate "normal"
    } else {
        puts " ! WARNUNG ! - cinematicDUMMY nicht gefunden !!!"
    }
}

#-------------------------------------------------------------------------------
#   playsound fileName
#
#   Play a high priority oneshot wav file.
#   Example:
#
#   playsound lib:sound/wolkentanz.wav
#-------------------------------------------------------------------------------
proc playsound {filename} {
    set action "/world.playsound $filename "
    oneshotaction 0.01 $action
}

#-------------------------------------------------------------------------------
#   playfeedbacksound fileName
#
#   Das playsound ist ja jetzt komplexer, wg oneshotaction -> also
#   gibt es jetzt noch ein einfacheres playfeedbacksound, welches wie frueher
#   funktioniert.
#-------------------------------------------------------------------------------
proc playfeedbacksound {filename} {
    /world.playsound $filename
}

#-------------------------------------------------------------------------------
#   findsymbol {symbolicName}
#
#   sucht object nach symbolicname und wenn nicht vorhanden meldung
#
#-------------------------------------------------------------------------------
proc findsymbol {symbolicName} {
    set pos [/world.findobjectbysymbolicname $symbolicName]
    if {$pos != "null"} {
        puts "position von: $symbolicName -> $pos"
        return $pos
    } else {
        puts " ! WARNUNG ! $symbolicName NICHT gefunden !!!"
    }
}

#-------------------------------------------------------------------------------
#   findclan {symbolicName}
#
#   sucht clan nach symbolicname und wenn nicht vorhanden meldung
#
#-------------------------------------------------------------------------------
proc findclan {symbolicName} {
    set pos [/world.findclanbysymbolicname $symbolicName]
    if {$pos != "null"} {
        puts "position von: $symbolicName -> $pos"
        return $pos
    } else {
        puts " ! WARNUNG ! $symbolicName NICHT gefunden !!!"
    }
}

#-------------------------------------------------------------------------------
#   switchoffnav {symbolicName} {symbolicName}
#
#   von den zwei ⁿbergebenen navpoints wird der nicht angefahrene disabled
#
#-------------------------------------------------------------------------------
proc switchoffnav {nav1Name nav2Name} {
    set nav1pos [/world.findobjectbysymbolicname $nav1Name]
    set nav2pos [/world.findobjectbysymbolicname $nav2Name]
    if { ($nav1pos != "null") &&  ($nav2pos != "null") } {
        set station [[/world.getuserclan].getplayerisland]
        set ziel [$station.getislandtarget]
        set zielsymbolicName [$ziel.getsymbolicname]
        if {$zielsymbolicName == $nav1Name} {
            puts "ziel: $nav1Name -> ausgeschalten: $nav2Name"
            disablenavpoint $nav2Name
        }
        if {$zielsymbolicName == $nav2Name} {
            puts "ziel: $nav2Name -> ausgeschalten: $nav1Name"
            disablenavpoint $nav1Name
        }
    } else {
        puts " ! WARNUNG ! $symbolicName NICHT gefunden !!!"
    }
}

#-------------------------------------------------------------------------------
#   Zeug zum an- und abschalten von Emittern
#-------------------------------------------------------------------------------
proc toggleemitter {symName onoff} {
    set obj ""
    set found 0
    for {set obj [/world.findobjectbysymbolicname $symName]}\
         {$obj != "null"}\
         {set obj [/world.findnextobjectbysymbolicname $obj $symName]} {

        set found 1
        $obj.enableemitting $onoff
    }

    if {$found == "0"} {
        puts " ! WARNUNG ! $symName NICHT gefunden !!!"
    }
}

proc enableemitter {symName} {
    toggleemitter $symName true
}

proc disableemitter {symName} {
    toggleemitter $symName false
}

#-------------------------------------------------------------------------------
#   Game over erzwingen
#-------------------------------------------------------------------------------
proc forcegameover {} {
#    /world.unsethandcontrol
#    /sys/servers/menuhandler.openmenu ingame_endgame

    # kill maennel
    set userClan [/world.getuserclan]
    if {$userClan != "null"} {
        set maennel [$userClan.getmaennel]
        if {$maennel != "null"} {
            $maennel.reduceenergy 10000000
        }
    }
}

#-------------------------------------------------------------------------------
#   Zeug zum an- und abschalten von Fabriken
#-------------------------------------------------------------------------------
proc togglefactory {symName onoff} {
    set obj [/world.findobjectbysymbolicname $symName]
    if {$obj == "null"} {
        puts " ! WARNUNG ! $symName NICHT gefunden !!!"
        return
    }
    $obj.setsleepmode $onoff
}

proc enablefactory {symName} {
    togglefactory $symName false
}

proc disablefactory {symName} {
    togglefactory $symName true
}

#-------------------------------------------------------------------------------
#   zum entfernen von objekten aus der szene
#-------------------------------------------------------------------------------
proc releasesymbol {symbolicName} {
    set obj [/world.findobjectbysymbolicname $symbolicName]
    if {$obj != "null"} {
        $obj.setremoveable true
        set objclan [$obj.getclan]
        $objclan.releasevehicle $obj
    } else {
        puts " ! WARNUNG ! $symbolicName NICHT gefunden !!!"
    }
}

proc release_clan {symbolicName} {
    set obj [/world.findclanbysymbolicname $symbolicName]
    if {$obj != "null"} {
        /world.releaseclan $obj
    } else {
        puts " ! WARNUNG ! $symbolicName NICHT gefunden !!!"
    }
}
#-------------------------------------------------------------------------------
#   zum entfernen von objekten aus der szene nach bestimmter zeit
#-------------------------------------------------------------------------------
proc releaseafter {time symbolicname {eventname "meier"}} {
    set action "releasesymbol $symbolicname"
    oneshotaction $time $action
}

#-------------------------------------------------------------------------------
#   artefact kann an bestimmten buildslot-Typ(1,2,3,4) gekoppelt werden
#   dh. das bauen ist dann auf diesem slot m÷glich
#-------------------------------------------------------------------------------
proc artefactmod {symbolicname buildslottyp} {
    set obj [/world.findobjectbysymbolicname $symbolicname]
    if {$obj != "null"} {
        set war [$obj.getbuildingclass]
        $obj.setbuildingclass $buildslottyp
        puts "TYPSWITCH FROM: $war TO: $buildslottyp"
    } else {
        puts " ! WARNUNG ! $symbolicName NICHT gefunden !!!"
    }
}

#-------------------------------------------------------------------------------
#   setplayerpos xPos yPos zPos yAngle
#
#   Saubere Maennel-Positionierungs-Routine, initialisiert Position/Blickrichtung,
#   setzt Speed auf 0 und koppelt evtl. von Insel ab.
#-------------------------------------------------------------------------------
proc setplayerpos {xPos yPos zPos yAngle} {
    set userClan [/world.getuserclan]
    if {$userClan != "null"} {

        # position maennel at towncenter
        set player [$userClan.getmaennel]
        $player.unlinkfromstation
        $player.setposition $xPos $yPos $zPos
        $player.setdirection 0 $yAngle 0
        $player.setspeed 0 0 0

        # reset collision system to flush preMove-Position
        #set curState [$player.getstate]
        #$player.setstate $curState
        $player.setstate "stand"
    }
}

#-------------------------------------------------------------------------------
#   missionobjective fileName (ohne Pfad)
#
#   Setzt den Namen der Bitmap, die als Mission Objective angezeigt wird
#
#-------------------------------------------------------------------------------
proc missionobjective {name} {
    /game/handler/cookie.setcookie __objective $name
}

#-------------------------------------------------------------------------------
#   textmessage name
#
#   Setzt den Namen der Message, die angezeigt werden soll
#
#-------------------------------------------------------------------------------
proc textmessage {name} {
    /sys/servers/menuhandler.showtextmessage "book:feedback/if_$name.bmp"
}
#-------------------------------------------------------------------------------
#   time display
#
#-------------------------------------------------------------------------------
proc timer_display {time} {
    if { $time == 10 } {
        textmessage noch10sec
    }
    if { $time == 30 } {
        textmessage noch30sec
        set time 10
        oneshotaction 20 "timer_display $time"
    }
    if { $time == 1 } {
        textmessage noch01min
        set time 30
        oneshotaction 30 "timer_display $time"
    }
    if { $time == 2 } {
        textmessage noch02min
    }
    if { $time == 3 } {
        textmessage noch03min
    }
    if { $time == 4 } {
        textmessage noch04min
    }
    if { $time == 5 } {
        textmessage noch05min
    }
    if { $time == 6 } {
        textmessage noch06min
    }
    if { $time == 7 } {
        textmessage noch07min
    }
    if { $time == 8 } {
        textmessage noch08min
    }

    if { $time < 10 } {
       set time [expr $time-1]
       oneshotaction 60 "timer_display $time"
    }
}

#-------------------------------------------------------------------------------
# Enter Vehicle.
#-------------------------------------------------------------------------------
proc entervehicle {who} {

    if {"null" == $who} {
        return
    }

    /world.sethandcontrol $who
    /world.setviewercarrier $who
    #input_possessingvehicle
    set userClan [/world.getuserclan]
    if {"null" != $userClan} {
        set maennel [$userClan.getmaennel]
        if {"null" != $maennel} {
            $maennel.setpossessingvehicle true
        }
    }
}

#-------------------------------------------------------------------------------
#   friendname
#
#   Liefert den Namen des Charakters, den der Spieler gewaehlt hat
#   (char_john, char_goliath oder char_susie
#
#-------------------------------------------------------------------------------
proc friendname {} {
    set name [/game/handler/cookie.getcookie "_character"]
    return $name
}

#-------------------------------------------------------------------------------
#   countplayerflaks
#
#   Liefert die anzahl der gebauten playerflaks zurueck
#
#-------------------------------------------------------------------------------
proc countplayerflaks {} {
    set result 0
    for {set curObj [/world.findobjectbysymbolicname "playerflak"]}\
    {$curObj != "null"}\
    {set curObj [/world.findnextobjectbysymbolicname $curObj "playerflak"]}\
    {
        if { [$curObj.getartefactmode] == "false" } {
            incr result 1
        }
    }
    puts "Anzahl gebauter FLAKS: $result"
    return $result
}

#-------------------------------------------------------------------------------
#   playerclanhasitem
#
#   liefert "true" bzw "false" zurⁿck - checken der playerclans
#
#-------------------------------------------------------------------------------
proc playerclanhasitem {symbolicName} {

    set clan [/world.getuserclan]
    set result   "false"

    for {set v [$clan.gethead]} {$v != "null"} {set v [$v.getsucc]} {
        if { [$v.getsymbolicname] == $symbolicName } {
            set result "true"
            break
            puts "im clan"
        }
    }
    return $result
}

#-------------------------------------------------------------------------------
#   EOF
#-------------------------------------------------------------------------------